﻿Imports System.Math
Public Class Metodo_Simplex
    Dim Funcion_Objetivo() As Double
    Public MM As String
    Dim Tamc, Tamf, sigIgual, nrodIgual, xD, yD, xP, yP, c, f, CoL, RoW As Integer
    ' sigigual= pa redim matriz..... nroigual cantidad d filas agregadas
    'row y col.. tamaño d matriz del tablero completo
    Dim Arreglo_Restricciones(,) As String
    Dim MAtriz1(,) As String
    Dim MAtrizF(,) As String
    Dim P As Boolean = False
    Dim D As Boolean = False
    Dim idenXs As Boolean = False

    Private Sub BtnCrear_Click_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnCrear.Click
        If TxtVariables.Text <> "" And TxtNroRest.Text <> "" And TxtVariables.Text <> "0" And TxtNroRest.Text <> "0" Then
            TablaRestricciones.ColumnCount = TxtVariables.Text + 2
            TablaRestricciones.RowCount = TxtNroRest.Text

            Tamf = TablaRestricciones.RowCount
            Tamc = TablaRestricciones.ColumnCount - 3
            For I = 0 To Tamc
                TablaRestricciones.Columns(I).Name = "X" & Int(I + 1)
            Next
            TablaRestricciones.Columns(TablaRestricciones.ColumnCount - 2).Name = "Signo"
            TablaRestricciones.Columns(TablaRestricciones.ColumnCount - 1).Name = " LD  "
            BtnFuncionObjetivo.Enabled = True
        Else
            MsgBox("Debe Completar Información", MsgBoxStyle.Critical)
            TxtVariables.Focus()
        End If
        NroEnFilas()
        BtnCrear.Enabled = False
        TablaRestricciones.Visible = True
    End Sub

    Private Sub BtnFO_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnFuncionObjetivo.Click
        Dim r As String
        Dim Pto As String

        ReDim Arreglo_Restricciones(Int(Tamf - 1), Int(Tamc + 2))
        If TxtVariables.Text <> "" And TxtNroRest.Text <> "" And MM <> "" Then
            ReDim Funcion_Objetivo(Tamc)
            LblFO.Text = ""
            'validando inputbox
            For I = 0 To Tamc
                Pto = 0
                r = InputBox("Ingrese Coeficiente de X" & I + 1 & "", "Función Objetivo", 1, , )
                If (r) = "" Then Exit Sub
                If Mid(r, 1, 1) = "-" Or IsNumeric(Mid(r, 1, 1)) = True Then
                    For x = 2 To Len(r)
                        If Mid(r, x, 1) = "." Then Pto = Pto + 1
                        If Pto = 0 Or Pto = 2 Then
                            If IsNumeric(Mid(r, x, 1)) = False Then
                                MsgBox("Debe Ingresar sólo números", MsgBoxStyle.Exclamation)
                                Exit Sub
                            End If
                        ElseIf Pto = 3 Then
                            MsgBox("Debe Ingresar sólo números", MsgBoxStyle.Exclamation)
                            Exit Sub
                        ElseIf Pto = 1 Then
                            Pto = Pto + 1
                        End If
                    Next
                Else
                    MsgBox("Debe Ingresar sólo números", MsgBoxStyle.Exclamation)
                    Exit Sub
                End If
                Funcion_Objetivo(I) = r
            Next

            For I = 0 To Funcion_Objetivo.Length - 1
                If Funcion_Objetivo(I) > 0 Then
                    LblFO.Text = LblFO.Text & " + " & Funcion_Objetivo(I) & "X" & I + 1
                Else
                    LblFO.Text = LblFO.Text & " - " & Mid(Funcion_Objetivo(I), 2, Len(Funcion_Objetivo(I))) & "X" & I + 1
                End If
            Next
            LblFO.Text = MM & " " & LblFO.Text
            BtnFuncionObjetivo.Enabled = False
            BtnCalcular.Enabled = True
        Else
            MsgBox("Debe seleccionar Maximizar o Minimizar", MsgBoxStyle.Information, "Función Objetivo")
            RtnMax.Focus()
        End If
    End Sub

    Private Sub BtnCalcular_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnCalcular.Click
        Dim m As Integer
        sigIgual = -1
        nrodIgual = 0
        If MM = "MIN" Then
            For i = 0 To Tamc
                Funcion_Objetivo(i) = Val(Funcion_Objetivo(i)) * (-1)
                MM = "MAX"
            Next
        End If
        For j = 0 To Tamf - 1
            For i = 0 To Tamc + 2
                If TablaRestricciones.Item(i, j).Value = "" Then
                    MsgBox("Debe ingresar las Restricciones", MsgBoxStyle.Critical, "Método Simplex")
                    Exit Sub
                End If
            Next
        Next
        TablaRestricciones.ReadOnly = True
        BtnCalcular.Enabled = False
        For i = 0 To Tamf - 1
            If TablaRestricciones.Item(Tamc + 1, i).Value = "=" Then
                sigIgual = sigIgual + 1
            End If
        Next
        ReDim Arreglo_Restricciones(Int(Tamf + sigIgual), Int(Tamc + 2))

        For i = 0 To Tamf - 1
            If Arreglo_Restricciones(m, 0) <> "" Then
                m = m + 1
                i = i - 1
            Else
                If TablaRestricciones.Item(Tamc + 1, i).Value = ">=" Then
                    For n = 0 To Tamc
                        Arreglo_Restricciones(m, n) = -1 * TablaRestricciones.Item(n, i).Value
                    Next
                    Arreglo_Restricciones(m, Tamc + 1) = -1 * TablaRestricciones.Item(Tamc + 2, i).Value
                    Arreglo_Restricciones(m, Tamc + 2) = "S" & m + 1
                    m = i
                ElseIf TablaRestricciones.Item(Tamc + 1, i).Value = "=" Then
                    For n = 0 To Tamc
                        Arreglo_Restricciones(m, n) = TablaRestricciones.Item(n, i).Value
                        Arreglo_Restricciones(m + 1, n) = -1 * TablaRestricciones.Item(n, i).Value
                    Next
                    Arreglo_Restricciones(m, Tamc + 1) = TablaRestricciones.Item(Tamc + 2, i).Value
                    Arreglo_Restricciones(m, Tamc + 2) = "H" & m + 1
                    Arreglo_Restricciones(m + 1, Tamc + 1) = -1 * TablaRestricciones.Item(Tamc + 2, i).Value
                    Arreglo_Restricciones(m + 1, Tamc + 2) = "S" & m + 2
                    nrodIgual = nrodIgual + 1
                Else
                    For n = 0 To Tamc
                        Arreglo_Restricciones(m, n) = TablaRestricciones.Item(n, i).Value
                    Next
                    Arreglo_Restricciones(m, Tamc + 1) = TablaRestricciones.Item(Tamc + 2, i).Value
                    Arreglo_Restricciones(m, Tamc + 2) = "H" & m + 1
                    m = i
                End If
            End If
        Next
        CoL = Tamc + 3
        RoW = Tamf + 2 + nrodIgual
        Tablero()
        If D = False And P = False Then
            MsgBox("No tiene solucion", MsgBoxStyle.Exclamation, "Simplex")
            'BtnSensibilidad.Enabled = False
            Exit Sub
        End If
        Do
            If D = True And P = True Then
                MContribucion()
            End If
            If P = True Then
                c = xP
                f = yP
                SimPlex()
                P = False
                'MsgBox("primal")
            ElseIf D = True Then
                c = xD
                f = yD
                SimPlex()
                D = False
                'MsgBox("dual")
            End If
            'completando datos
            For i = 0 To CoL
                For j = 0 To RoW
                    MAtriz1(j, i) = MAtrizF(j, i)
                Next
            Next
            Primal()
            Dual()
        Loop While (D = True Or P = True)
        If D = False And P = False Then
            tabFinal()
        End If
        'BtnSensibilidad.Enabled = True
    End Sub
    Sub SimPlex()
        'c=col ... f=fila coordenadas dl var d entrant con variabl salient
        ReDim MAtrizF(RoW, CoL)
        MAtrizF(f, c) = (MAtriz1(f, c)) ^ -1 'pivot
        'intercambiando vars
        For j = 0 To 1
            MAtrizF(j, c) = MAtriz1(f, j)
            MAtrizF(f, j) = MAtriz1(j, c)
        Next
        'vars entrants -> columna
        For j = 2 To RoW
            If j <> f Then
                MAtrizF(j, c) = -1 * (MAtriz1(j, c)) / (MAtriz1(f, c))
            End If
        Next
        'vars salients-> fila
        For i = 2 To CoL
            If i <> c Then
                MAtrizF(f, i) = (MAtriz1(f, i)) / (MAtriz1(f, c))
            End If
        Next
        'regla simple pa casilleros en matriz
        For i = 2 To CoL
            If i <> c Then
                For j = 2 To RoW
                    If j <> f Then
                        MAtrizF(j, i) = (MAtriz1(j, i)) - (((MAtriz1(j, c)) * (MAtriz1(f, i))) / (MAtriz1(f, c)))
                    End If
                Next
            End If
        Next
        'completando datos
        For i = 0 To CoL
            For j = 0 To RoW
                If MAtrizF(j, i) = "" Then
                    MAtrizF(j, i) = MAtriz1(j, i)
                End If
            Next
        Next

    End Sub
    Private Sub tabFinal() 'del tablero final evaluar LD y Zj positivos pa hallar opti y facti
        Dim LDp, ZJp As Integer
        'valores LD positivos
        For j = 2 To RoW - 1
            If MAtrizF(j, CoL) >= 0 Then
                LDp = LDp + 1
            End If
        Next
        If LDp <> (RoW - 2) Then
            LblComentario.Text = LblComentario.Text & "- No es Factible -"
            'BtnSensibilidad.Enabled = False
        End If
        'valores ZJ positivos
        For i = 2 To CoL - 1
            If MAtrizF(RoW, i) > 0 Then
                ZJp = ZJp + 1
            End If
        Next
        If ZJp <> (CoL - 2) Then
            LblComentario.Text = LblComentario.Text & "- No es Optimo -"
            'BtnSensibilidad.Enabled = False
        End If
        'todos positivos.. OPTIMO
        If LDp = (RoW - 2) And ZJp = (CoL - 2) Then
            MsgBox("Tablero Optimo", MsgBoxStyle.Exclamation, "Simplex")
            idenXs = True
            If Mid(LblFO.Text, 1, 3) = "MIN" Then
                LblZ.Text = "Valor de Z = " & -1 * Format(Val(MAtrizF(RoW, CoL)), "0.00")
            Else
                LblZ.Text = "Valor de Z = " & Format(Val(MAtrizF(RoW, CoL)), "0.00")
            End If
        End If
        MostrarTablero()
    End Sub
    Private Sub MostrarTablero()
        'DGResul.ColumnCount = 0
        'DGResul.RowCount = 0
        TablaResultado.ColumnCount = CoL + 1
        TablaResultado.RowCount = RoW + 1

        For i = 0 To CoL
            For j = 0 To RoW
                If i > 1 And j > 1 Then
                    TablaResultado.Item(i, j).Value = Format(Val(MAtrizF(j, i)), "0.00")
                Else
                    TablaResultado.Item(i, j).Value = MAtrizF(j, i)
                End If
            Next
        Next

        'IDENTIFICANDO VARIABLES Xs
        If idenXs = True Then
            For j = 2 To RoW - 1
                If Mid(MAtrizF(j, 1), 1, 1) = "X" Then
                    LblXs.Text = LblXs.Text & "   " & MAtrizF(j, 1) & " = " & Format(Val(MAtrizF(j, CoL)), "0.00")
                End If
            Next
            For I = 2 To CoL - 1
                If Mid(MAtrizF(1, I), 1, 1) = "X" Then
                    LblXs.Text = LblXs.Text & "   " & MAtrizF(1, I) & " = 0 "
                End If
            Next
            TablaResultado.Visible = True
            'BtnSensibilidad.Enabled = True
        Else
            MsgBox("No tiene solución", MsgBoxStyle.Exclamation, "Simplex")
            'BtnSensibilidad.Enabled = False
        End If
    End Sub
    Private Sub Primal()
        Dim AuxP As Integer  'i,x=col ... j,y=fila
        xP = 0
        yP = 0
        If P = False Then
            'valores zj negativos
            For i = 2 To CoL - 1
                If MAtriz1(RoW, i) < 0 Then
                    If AuxP > MAtriz1(RoW, i) Then
                        AuxP = MAtriz1(RoW, i)
                        xP = i
                    End If
                End If
            Next
            'hallando pivote primal
            If AuxP < 0 Then
                AuxP = 0
                For j = 2 To RoW - 1
                    If MAtriz1(j, xP) > 0 Then
                        If MAtriz1(j, CoL) >= 0 Then
                            If AuxP = 0 Then
                                AuxP = Abs(Val(MAtriz1(j, CoL)) / Val(MAtriz1(j, xP)))
                                yP = j
                                P = 1
                            ElseIf AuxP > Abs((Val(MAtriz1(j, CoL)) / Val(MAtriz1(j, xP)))) Then
                                AuxP = Abs(Val(MAtriz1(j, CoL)) / Val(MAtriz1(j, xP)))
                                yP = j
                                P = 1
                            End If
                        End If
                    End If
                Next
            End If
        Else
            MsgBox("primal")
        End If
        'MsgBox(P & " " & MAtriz1(yP, n) & " " & MAtriz1(m, xP) & " " & MAtriz1(yP, xP))

    End Sub

    Private Sub Dual()
        Dim AuxD As Integer = 0  'i,x=col ... j,y=fila .... x,y fijos
        Dim vNeg As Boolean = False
        xD = 0
        yD = 0
        If D = False Then
            'valores LD negativos
            For j = 2 To RoW - 1
                If MAtriz1(j, CoL) <= 0 Then
                    If AuxD > MAtriz1(j, CoL) Then
                        AuxD = MAtriz1(j, CoL)
                        yD = j
                    End If
                End If
            Next
            'valores ZJ positivos
            For i = 2 To CoL - 1
                If MAtriz1(RoW, i) > 0 Then
                    vNeg = True
                End If
            Next

            If vNeg = False Or yD = 0 Then
                'MsgBox(D & " " & MAtriz1(yD, CoL) & " " & MAtriz1(RoW, xD) & " " & MAtriz1(yD, xD))
                Exit Sub
            End If

            If AuxD < 0 Then
                AuxD = 0
                For i = 2 To CoL - 1
                    If MAtriz1(yD, i) < 0 Then
                        If MAtriz1(RoW, i) >= 0 Then
                            If AuxD = 0 Then
                                AuxD = Abs(Val(MAtriz1(RoW, i)) / Val(MAtriz1(yD, i)))
                                xD = i
                                D = True
                            ElseIf AuxD > Abs(Val(MAtriz1(RoW, i)) / Val(MAtriz1(yD, i))) Then
                                AuxD = Abs(Val(MAtriz1(RoW, i)) / Val(MAtriz1(yD, i)))
                                xD = i
                                D = True
                            End If
                        End If
                    End If
                Next
            End If
        Else
            MsgBox("dual")
        End If
        'MsgBox(D & " " & MAtriz1(yD, n) & " " & MAtriz1(m, xD) & " " & MAtriz1(yD, xD))
        'MsgBox(PivoteD & " " & D & " " & MAtriz1(m, xD) & " " & LD)
    End Sub
    Private Sub NroEnFilas()
        Dim rowNumber As Integer = 1
        For Each row As DataGridViewRow In TablaRestricciones.Rows
            If row.IsNewRow Then Continue For
            row.HeaderCell.Value = rowNumber.ToString
            rowNumber = rowNumber + 1
        Next
        'DGRestr.AutoResizeRowHeadersWidth(DataGridViewRowHeadersWidthSizeMode.AutoSizeToDisplayedHeaders)
        TablaRestricciones.RowHeadersWidth = 40
    End Sub
    Private Sub Tablero()
        'i=col ... j=fila
        ReDim MAtriz1(Int(RoW), Int(CoL))
        'almacenando el vector de funcion objetivo FO. y zj
        For i = 0 To Funcion_Objetivo.Length - 1
            MAtriz1(0, i + 2) = Funcion_Objetivo(i)
            MAtriz1(RoW, i + 2) = -1 * Funcion_Objetivo(i)
        Next
        'almacenando las restriccions
        For j = 0 To Tamf + sigIgual
            For i = 0 To Tamc + 1
                MAtriz1(j + 2, i + 2) = Arreglo_Restricciones(j, i)
                MAtriz1(j + 2, 1) = Arreglo_Restricciones(j, Tamc + 2)
            Next
        Next
        'almacenando las nombre variabls Xi restriccions
        For i = 0 To Tamc
            MAtriz1(1, i + 2) = TablaRestricciones.Columns(i).Name
        Next
        'completando con 0
        For j = 2 To RoW - 1
            MAtriz1(j, 0) = "0"
        Next
        Primal()
        Dual()
    End Sub
    Private Sub MContribucion()
        Dim MCont As Integer
        If P = True And D = True Then
            P = False
            D = False
            MCont = Abs((MAtriz1(RoW, xP) / MAtriz1(yP, xP)) * MAtriz1(yP, CoL))
            If MCont < Abs((MAtriz1(RoW, xD) / MAtriz1(yD, xD)) * MAtriz1(yD, CoL)) Then
                MCont = Abs((MAtriz1(RoW, xD) / MAtriz1(yD, xD)) * MAtriz1(yD, CoL))
                D = True
            Else
                P = True
            End If
        End If

    End Sub
    Private Sub RtnMin_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles RtnMin.Click
        MM = "MIN"

    End Sub

    Private Sub RtnMax_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles RtnMax.Click
        MM = "MAX"
    End Sub
    'para validacion de datagridview
    Private Sub DGRestr_EditingControlShowing(ByVal sender As Object, ByVal e As System.Windows.Forms.DataGridViewEditingControlShowingEventArgs) Handles TablaRestricciones.EditingControlShowing
        ' referencia a la celda   
        Dim validar As TextBox = CType(e.Control, TextBox)

        ' agregar el controlador de eventos para el KeyPress   
        AddHandler validar.KeyPress, AddressOf validar_Keypress
    End Sub
    'evento Keypress   
    '''''''''''''''''''  
    Private Sub validar_Keypress(ByVal sender As Object, ByVal e As System.Windows.Forms.KeyPressEventArgs)
        Dim caracter As Char = e.KeyChar
        Dim columna As Integer = TablaRestricciones.CurrentCell.ColumnIndex

        ' comprobar si la celda en edición corresponde a la columna del signo   
        If columna = Tamc + 1 Then
            ' Obtener caracter   
            ' comprobar si el caracter es un número o el retroceso   
            If Not (Asc(e.KeyChar) = 60 Or Asc(e.KeyChar) = 61 Or Asc(e.KeyChar) = 62 Or (caracter = ChrW(Keys.LShiftKey)) And (caracter = ChrW(Keys.RShiftKey)) Or (caracter = ChrW(Keys.Back))) Then
                e.KeyChar = Chr(0)
            End If

        Else
            ' comprobar si el caracter es un número o el retroceso   
            'If Char.IsNumber(caracter) Or (caracter = ChrW(Keys.Back)) Or (Asc(e.KeyChar) = 46) Or ((Asc(e.KeyChar) = 45)) Then
            '    ' (Asc(e.KeyChar) = 45) ' para escribir negativo -
            '    If (((Asc(e.KeyChar) = 45))) Then
            '        If SnEg = False Then
            '            SnEg = True
            '        Else
            '            e.KeyChar = Chr(0)
            '        End If
            '    End If
            'Else
            '    e.KeyChar = Chr(0)
            'End If
            If Not Char.IsNumber(caracter) And (caracter = ChrW(Keys.Back)) = False And Not ((Asc(e.KeyChar) = 46) Or ((Asc(e.KeyChar) = 45))) Then
                ' (Asc(e.KeyChar) = 45) ' pa scribir negativo -
                e.KeyChar = Chr(0)
            End If
        End If
    End Sub


    Private Sub BtnNuevo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles BtnNuevo.Click
        TxtNroRest.Text = ""
        TxtVariables.Text = ""
        TablaRestricciones.Visible = False
        TablaResultado.Visible = False
        LblComentario.Text = ""
        LblFO.Text = ""
        LblXs.Text = ""
        LblZ.Text = ""
        BtnCrear.Enabled = True
    End Sub
End Class
